home *** CD-ROM | disk | FTP | other *** search
/ SGI Freeware 1999 August / SGI Freeware 1999 August.iso / dist / fw_xemacs.idb / usr / freeware / lib / xemacs-20.4 / lisp / prim / undo-stack.el.z / undo-stack.el
Encoding:
Text File  |  1998-05-21  |  9.5 KB  |  264 lines
  1. ;;; undo-stack.el --- An "undoable stack" object.
  2. ;; Keywords: extensions
  3.  
  4. ;; Copyright (C) 1996 Ben Wing.
  5.  
  6. ;; This file is part of XEmacs.
  7.  
  8. ;; XEmacs is free software; you can redistribute it and/or modify it
  9. ;; under the terms of the GNU General Public License as published by
  10. ;; the Free Software Foundation; either version 2, or (at your option)
  11. ;; any later version.
  12.  
  13. ;; XEmacs is distributed in the hope that it will be useful, but
  14. ;; WITHOUT ANY WARRANTY; without even the implied warranty of
  15. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  16. ;; General Public License for more details.
  17.  
  18. ;; You should have received a copy of the GNU General Public License
  19. ;; along with XEmacs; see the file COPYING.  If not, write to the 
  20. ;; Free Software Foundation, 59 Temple Place - Suite 330,
  21. ;; Boston, MA 02111-1307, USA.
  22.  
  23. ;;; Synched up with: Not in FSF.
  24.  
  25. ;;; Commentary:
  26.  
  27. ;;; An "undoable stack" is an object that can be used to implement
  28. ;;; a history of positions, with undo and redo.  Conceptually, it
  29. ;;; is the kind of data structure used to keep track of (e.g.)
  30. ;;; visited Web pages, so that the "Back" and "Forward" operations
  31. ;;; in the browser work.  Basically, I can successively visit a
  32. ;;; number of Web pages through links, and then hit "Back" a
  33. ;;; few times to go to previous positions, and then "Forward" a
  34. ;;; few times to reverse this process.  This is similar to an
  35. ;;; "undo" and "redo" mechanism.
  36. ;;;
  37. ;;; Note that Emacs does not standardly contain structures like
  38. ;;; this.  Instead, it implements history using either a ring
  39. ;;; (the kill ring, the mark ring), or something like the undo
  40. ;;; stack, where successive "undo" operations get recorded as
  41. ;;; normal modifications, so that if you do a bunch of successive
  42. ;;; undo's, then something else, then start undoing, you will
  43. ;;; be redoing all your undo's back to the point before you did
  44. ;;; the undo's, and then further undo's will act like the previous
  45. ;;; round of undo's.  I think that both of these paradigms are
  46. ;;; inferior to the "undoable-stack" paradigm because they're
  47. ;;; confusing and difficult to keep track of.
  48. ;;;
  49. ;;; Conceptually, imagine a position history like this:
  50. ;;;
  51. ;;;   1 -> 2 -> 3 -> 4 -> 5 -> 6
  52. ;;;                            ^^
  53. ;;;
  54. ;;; where the arrow indicates where you currently are.  "Going back"
  55. ;;; and "going forward" just amount to moving the arrow.  However,
  56. ;;; what happens if the history state is this:
  57. ;;;
  58. ;;;   1 -> 2 -> 3 -> 4 -> 5 -> 6
  59. ;;;                  ^^
  60. ;;;
  61. ;;; and then I visit new positions (7) and (8)?  In the most general
  62. ;;; implementation, you've just caused a new branch like this:
  63. ;;;
  64. ;;;   1 -> 2 -> 3 -> 4 -> 5 -> 6
  65. ;;;                  |
  66. ;;;                  |
  67. ;;;                  7 -> 8
  68. ;;;                       ^^
  69. ;;;
  70. ;;; But then you can end up with a whole big tree, and you need
  71. ;;; more sophisticated ways of navigating ("Forward" might involve
  72. ;;; a choice of paths to follow) and managing its size (if you don't
  73. ;;; want to keep unlimited history, you have to truncate at some point,
  74. ;;; and how do you truncate a tree?)
  75. ;;;
  76. ;;; My solution to this is just to insert the new positions like
  77. ;;; this:
  78. ;;;
  79. ;;;   1 -> 2 -> 3 -> 4 -> 7 -> 8 -> 5 -> 6
  80. ;;;                            ^^
  81. ;;;
  82. ;;; (Netscape, I think, would just truncate 5 and 6 completely,
  83. ;;; but that seems a bit drastic.  In the Emacs-standard "ring"
  84. ;;; structure, this problem is avoided by simply moving 5 and 6
  85. ;;; to the beginning of the ring.  However, it doesn't seem
  86. ;;; logical to me to have "going back past 1" get you to 6.)
  87. ;;;
  88. ;;; Now what if we have a "maximum" size of (say) 7 elements?
  89. ;;; When we add 8, we could truncate either 1 or 6.  Since 5 and
  90. ;;; 6 are "undone" positions, we should presumably truncate
  91. ;;; them before 1.  So, adding 8 truncates 6, adding 9 truncates
  92. ;;; 5, and adding 10 truncates 1 because there is nothing more
  93. ;;; that is forward of the insertion point.
  94. ;;;
  95. ;;; Interestingly, this method of truncation is almost like
  96. ;;; how a ring would truncate.  A ring would move 5 and 6
  97. ;;; around to the back, like this:
  98. ;;;
  99. ;;;   5 -> 6 -> 1 -> 2 -> 3 -> 4 -> 7 -> 8
  100. ;;;                                      ^^
  101. ;;;
  102. ;;; However, when 8 is added, the ring truncates 5 instead of
  103. ;;; 6, which is less than optimal.
  104. ;;;
  105. ;;; Conceptually, we can implement the "undoable stack" using
  106. ;;; two stacks of a sort called "truncatable stack", which are
  107. ;;; just simple stacks, but where you can truncate elements
  108. ;;; off of the bottom of the stack.  Then, the undoable stack
  109. ;;;
  110. ;;;   1 -> 2 -> 3 -> 4 -> 5 -> 6
  111. ;;;                  ^^
  112. ;;;
  113. ;;; is equivalent to two truncatable stacks:
  114. ;;;
  115. ;;;   4 <- 3 <- 2 <- 1
  116. ;;;   5 <- 6
  117. ;;;
  118. ;;; where I reversed the direction to accord with the probable
  119. ;;; implementation of a standard list.  To do another undo,
  120. ;;; I pop 4 off of the first stack and move it to the top of
  121. ;;; the second stack.  A redo operation does the opposite.
  122. ;;; To truncate to the proper size, first chop off 6, then 5,
  123. ;;; then 1 -- in all cases, truncating off the bottom.
  124.  
  125. (define-error 'trunc-stack-bottom "Bottom of stack reached.")
  126.  
  127. (defsubst trunc-stack-stack (stack)
  128.   ;; return the list representing the trunc-stack's elements.
  129.   ;; the head of the list is the most recent element.
  130.   (aref stack 1))
  131.  
  132. (defsubst trunc-stack-length (stack)
  133.   ;; return the number of elements in the trunc-stack.
  134.   (aref stack 2))
  135.  
  136. (defsubst set-trunc-stack-stack (stack new)
  137.   ;; set the list representing the trunc-stack's elements.
  138.   (aset stack 1 new))
  139.  
  140. (defsubst set-trunc-stack-length (stack new)
  141.   ;; set the length of the trunc-stack.
  142.   (aset stack 2 new))
  143.  
  144. ;; public functions:
  145.  
  146. (defun make-trunc-stack ()
  147.   ;; make an empty trunc-stack.
  148.   (vector 'trunc-stack nil 0))
  149.  
  150. (defun trunc-stack-push (stack el)
  151.   ;; push a new element onto the head of the trunc-stack.
  152.   (set-trunc-stack-stack stack (cons el (trunc-stack-stack stack)))
  153.   (set-trunc-stack-length stack (1+ (trunc-stack-length stack))))
  154.  
  155. (defun trunc-stack-top (stack &optional n)
  156.   ;; return the nth topmost element from the trunc-stack.
  157.   ;; signal an error if the stack doesn't have that many elements.
  158.   (or n (setq n 0))
  159.   (if (>= n (trunc-stack-length stack))
  160.       (signal-error 'trunc-stack-bottom (list stack))
  161.     (nth n (trunc-stack-stack stack))))
  162.  
  163. (defun trunc-stack-pop (stack)
  164.   ;; pop and return the topmost element from the stack.
  165.   (prog1 (trunc-stack-top stack)
  166.     (set-trunc-stack-stack stack (cdr (trunc-stack-stack stack)))
  167.     (set-trunc-stack-length stack (1- (trunc-stack-length stack)))))
  168.  
  169. (defun trunc-stack-truncate (stack &optional n)
  170.   ;; truncate N items off the bottom of the stack.  If the stack is
  171.   ;; not that big, it just becomes empty.
  172.   (or n (setq n 1))
  173.   (if (> n 0)
  174.       (let ((len (trunc-stack-length stack)))
  175.     (if (>= n len)
  176.         (progn
  177.           (set-trunc-stack-length stack 0)
  178.           (set-trunc-stack-stack stack nil))
  179.       (setcdr (nthcdr (1- (- len n)) (trunc-stack-stack stack)) nil)
  180.       (set-trunc-stack-length stack (- len n))))))
  181.  
  182. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  183.  
  184. ;;; FMH! FMH! FMH!  This object-oriented stuff doesn't really work
  185. ;;; properly without built-in structures (vectors suck) and without
  186. ;;; public and private functions and fields.
  187.  
  188. (defsubst undoable-stack-max (stack)
  189.   (aref stack 1))
  190.  
  191. (defsubst undoable-stack-a (stack)
  192.   (aref stack 2))
  193.  
  194. (defsubst undoable-stack-b (stack)
  195.   (aref stack 3))
  196.  
  197. ;; public functions:
  198.  
  199. (defun make-undoable-stack (max)
  200.   ;; make an empty undoable stack of max size MAX.
  201.   (vector 'undoable-stack max (make-trunc-stack) (make-trunc-stack)))
  202.  
  203. (defsubst set-undoable-stack-max (stack new)
  204.   ;; change the max size of an undoable stack.
  205.   (aset stack 1 new))
  206.  
  207. (defun undoable-stack-a-top (stack)
  208.   ;; return the topmost element off the "A" stack of an undoable stack.
  209.   ;; this is the most recent position pushed on the undoable stack.
  210.   (trunc-stack-top (undoable-stack-a stack)))
  211.  
  212. (defun undoable-stack-a-length (stack)
  213.   (trunc-stack-length (undoable-stack-a stack)))
  214.  
  215. (defun undoable-stack-b-top (stack)
  216.   ;; return the topmost element off the "B" stack of an undoable stack.
  217.   ;; this is the position that will become the most recent position,
  218.   ;; after a redo operation.
  219.   (trunc-stack-top (undoable-stack-b stack)))
  220.  
  221. (defun undoable-stack-b-length (stack)
  222.   (trunc-stack-length (undoable-stack-b stack)))
  223.  
  224. (defun undoable-stack-push (stack el)
  225.   ;; push an element onto the stack.
  226.   (let*
  227.       ((lena (trunc-stack-length (undoable-stack-a stack)))
  228.        (lenb (trunc-stack-length (undoable-stack-b stack)))
  229.        (max (undoable-stack-max stack))
  230.        (len (+ lena lenb)))
  231.     ;; maybe truncate some elements.  We have to deal with the
  232.     ;; possibility that we have more elements than our max
  233.     ;; (someone might have reduced the max).
  234.     (if (>= len max)
  235.     (let ((must-nuke (1+ (- len max))))
  236.       ;; chop off must-nuke elements from the B stack.
  237.       (trunc-stack-truncate (undoable-stack-b stack) must-nuke)
  238.       ;; but if there weren't that many elements to chop,
  239.       ;; take the rest off the A stack.
  240.       (if (< lenb must-nuke)
  241.           (trunc-stack-truncate (undoable-stack-a stack)
  242.                     (- must-nuke lenb)))))
  243.     (trunc-stack-push (undoable-stack-a stack) el)))
  244.  
  245. (defun undoable-stack-pop (stack)
  246.   ;; pop an element off the stack.
  247.   (trunc-stack-pop (undoable-stack-a stack)))
  248.  
  249. (defun undoable-stack-undo (stack)
  250.   ;; transfer an element from the top of A to the top of B.
  251.   ;; return value is undefined.
  252.   (trunc-stack-push (undoable-stack-b stack)
  253.             (trunc-stack-pop (undoable-stack-a stack))))
  254.  
  255. (defun undoable-stack-redo (stack)
  256.   ;; transfer an element from the top of B to the top of A.
  257.   ;; return value is undefined.
  258.   (trunc-stack-push (undoable-stack-a stack)
  259.             (trunc-stack-pop (undoable-stack-b stack))))
  260.  
  261.  
  262.  
  263.  
  264.